home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / T U R B O Language / Turbo Pascal V7.0 / UTILS.ZIP / GREP2MSG.PAS < prev    next >
Pascal/Delphi Source File  |  1992-10-30  |  1KB  |  68 lines
  1. program Grep2Msg;
  2.  
  3. {$I-,S-}
  4.  
  5. var
  6.   LineNo, E: Word;
  7.   Line: String;
  8.   InputBuffer: array[0..4095] of Char;
  9.   OutputBuffer: array[0..4095] of Char;
  10.  
  11. procedure WriteHeader;
  12. begin
  13.   Write('BI#PIP#OK'#0);
  14. end;
  15.  
  16. procedure WriteNewFile(const FileName: String);
  17. begin
  18.   Write(#0, FileName, #0);
  19. end;
  20.  
  21. procedure WriteMessage(Line, Col: Word; const Message: String);
  22. begin
  23.   Write(#1, Chr(Lo(Line)), Chr(Hi(Line)), Chr(Lo(Col)), Chr(Hi(Col)),
  24.     Message, #0);
  25. end;
  26.  
  27. procedure WriteEnd;
  28. begin
  29.   Write(#127);
  30. end;
  31.  
  32. function TrimLeft(S:String): String;
  33. var
  34.   i: Integer;
  35.   n: String;
  36. begin
  37.   i := 1;
  38.   while (i <= Length(s)) and (s[i] = #32) do Inc(i);
  39.   if i <= Length(s) then
  40.   begin
  41.     Move(s[i], n[1], Length(s) - i + 1);
  42.     n[0] := Char(Length(s) - i + 1);
  43.   end
  44.   else n[0] := #0;
  45.   TrimLeft := n;
  46. end;
  47.  
  48. begin
  49.   SetTextBuf(Input, InputBuffer);
  50.   SetTextBuf(Output, OutputBuffer);
  51.   WriteHeader;
  52.   while not Eof do
  53.   begin
  54.     ReadLn(Line);
  55.     if Line <> '' then
  56.     begin
  57.       if Copy(Line, 1, 5) = 'File ' then
  58.         WriteNewFile(Copy(Line, 6, Length(Line) - 6))
  59.       else
  60.       begin
  61.         Val(Copy(Line, 1, Pos(' ', Line) - 1), LineNo, E);
  62.         if E = 0 then WriteMessage(LineNo, 1, TrimLeft(Copy(Line, 9, 132)));
  63.       end;
  64.     end;
  65.   end;
  66.   WriteEnd;
  67. end.
  68.